home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0023_Excellent ReadString.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  5KB  |  127 lines
  1. Procedure ReadS (Var NewIn : String; OldIn : String; X,Y,Colr,MaxLen : Byte;
  2.                  ValidChars : ChSet; FChar : Char);
  3.  
  4.               (* NewIn      = String entered by user, or default string if
  5.                               nothing new entered.  Self-modified.
  6.                  OldIn      = Default or old data entered
  7.                  X,Y        = Coordinates of beginning point to read
  8.                  Colr       = Color of input
  9.                  MaxLen     = Maximum length of input
  10.                  ValidChars = A Set of Char that outlines which keys can be
  11.                               used in entering string.  ie: ['A'..'Z','a'..'z']
  12.                  FChar      = Filler character for End-of-String
  13.               *)
  14.  
  15.   (* When called, prompt should be on screen.  NewIn var will be modified only
  16.      at exit of ReadS, otherwise will return nothing.  If ESC is pressed, NewIn
  17.      will again be blank, otherwise will contain the user input or default
  18.      string.
  19.  
  20.  
  21.   ** NOTE **  There are certain functions required to make this entire
  22.               procedure work.  They are not necessary, but make it nicer to
  23.               use.  These are:
  24.  
  25.                     GetCursor
  26.                     SetCursor
  27.                     WriteS (fast writes to screen, see next few posts)
  28.  
  29.   *)
  30.  
  31.   (* Standard disclaimer: I'm not liable for anything this procedure does
  32.                           outside the original purpose of the procedure.  If
  33.                           something bad happens, let me know, but that's all
  34.                           I can do.
  35.   *)
  36.  
  37. Var
  38.    CurX, StLen                          : Byte;
  39.    OldCursor                            : Word;
  40.  
  41. Begin
  42.      NewIn := '';
  43.      InsOn := True;
  44.      InStr := OldIn;
  45.      StLen := Length (OldIn);
  46.      Colr := CheckColor (Colr);
  47.      For I := StLen To MaxLen-1 Do
  48.          WriteS (FChar,X+I,Y,Colr);
  49.      WriteS (OldIn,X,Y,HiColr);
  50.      CurX := Length (InStr)+X;
  51.      ValidChars := ValidChars + [#8,#13,#210,#211] + HKeySet + FuncKeys;
  52. {arrowk     OldCursor := GetCursor;
  53.      Repeat
  54.            If InsOn Then
  55.               SetCursor (DefaultCursor)
  56.            Else
  57.                SetCursor (BlockCursor);
  58.            GotoXY (CurX,Y);
  59.            StLen := Length (InStr);
  60.            For I := StLen To MaxLen-1 Do
  61.                If Colr < 112 Then
  62.                   WriteS (FChar,X+I,Y,HiColr)
  63.                Else
  64.                    WriteS (FChar,X+I,Y,Colr);
  65.            Repeat
  66.                  Repeat
  67.                        Ch := ReadKey;
  68.                  Until (Ch <> #13) Or ((Ch = #13) And (InStr <> ''));
  69.            Until (Ch In ValidChars);
  70.            Case Ch Of
  71.                 #8:
  72.                 Begin
  73.                      If (CurX > X) And (Length (InStr) > 0) Then
  74.                      Begin
  75.                           Dec (CurX);
  76.                           If InsOn Then
  77.                              Delete (InStr,(CurX-X)+1,1)
  78.                           Else
  79.                               InStr[(CurX-X)+1] := #32;
  80.                      End;
  81.                 End;
  82.                 #203: { Left arrow }
  83.                       If CurX > X Then
  84.                          Dec (CurX);
  85.                 #205: { Right arrow }
  86.                       If CurX < X+Length (InStr) Then
  87.                          Inc (CurX);
  88.                 #199: { Home }
  89.                       CurX := X;
  90.                 #207: { End }
  91.                       CurX := X+Length (InStr);
  92.                 #210: { Insert }
  93.                       InsOn := InsOn XOr True;
  94.                 #211: { Delete }
  95.                       Delete (InStr,(CurX-X)+1,1);
  96.                 #65..#90,
  97.                 #97..#122, { Alphabet }
  98.                 #48..#57,  { Numbers }
  99.                 #91..#96,
  100.                 #32..#47,
  101.                 #58..#64:  { Other chars }
  102.                 Begin
  103.                      If (CurX-X < MaxLen) And (Length (InStr) < MaxLen) Then
  104.                      Begin
  105.                           InStr[0] := Chr (Ord (InStr[0])+1);
  106.                           InStr[Length (InStr)] := #0;
  107.                           If InsOn Then
  108.                                Insert (Ch,InStr,(CurX-X)+1)
  109.                           Else
  110.                                InStr[(CurX-X)+1] := Ch;
  111.                           Inc (CurX);
  112.                      End;
  113.                 End;
  114.            End;
  115.            While Pos (#0,InStr) > 0 Do
  116.                  Delete (InStr,Pos (#0,InStr),1);
  117.            WriteS (InStr,X,Y,Colr);
  118.      Until (Ch = #13) Or (Ch = #27);
  119.      For I := Length (InStr) To MaxLen-1 Do
  120.          WriteS (#32,I+X,Y,7);
  121.      If Ch = #27 Then
  122.         NewIn := ''
  123.      Else
  124.          NewIn := InStr;
  125.      SetCursor (OldCursor);
  126. End;
  127.